library(GeoPressureR)
library(leaflet)
library(leaflet.extras)
library(raster)
library(dplyr)
library(ggplot2)
library(plotly)
knitr::opts_chunk$set(echo = params$printcode)
load(paste0("../data/6_basic_graph/", params$gdl_id, "_basic_graph.Rdata"))
load(paste0("../data/5_static_prob/", params$gdl_id, "_static_prob.Rdata"))

Pressure timeserie

pressure_na <- pam$pressure %>%
  mutate(obs = ifelse(isoutliar | sta_id == 0, NA, obs))
p <- ggplot() +
  geom_line(data = pam$pressure, aes(x = date, y = obs), colour = "grey") +
  # geom_point(data = subset(pam$pressure, isoutliar), aes(x = date, y = obs), colour = "black") +
  geom_line(data = pressure_na, aes(x = date, y = obs, color = factor(sta_id)), size = 0.5) +
  geom_line(data = do.call("rbind", shortest_path_timeserie), aes(x = date, y = pressure0, col = factor(sta_id)), linetype = 2) +
  theme_bw() +
  scale_colour_manual(values = col) +
  scale_y_continuous(name = "Pressure(hPa)")

ggplotly(p, dynamicTicks = T) %>% layout(showlegend = F)

Alitude

p <- ggplot() +
  # geom_line(data = pam$pressure, aes(x = date, y = obs), colour = "grey") +
  geom_line(data = do.call("rbind", shortest_path_timeserie), aes(x = date, y = altitude, col = factor(sta_id))) +
  theme_bw() +
  scale_colour_manual(values = col) +
  scale_y_continuous(name = "Altitude (m)")

ggplotly(p, dynamicTicks = T) %>% layout(showlegend = F)

Shortest path and simulated path

sta_duration <- unlist(lapply(static_prob_marginal, function(x) {
  as.numeric(difftime(metadata(x)$temporal_extent[2], metadata(x)$temporal_extent[1], units = "days"))
}))
pal <- colorFactor(col, as.factor(seq_len(length(col))))
m <- leaflet(width = "100%") %>%
  addProviderTiles(providers$Stamen.TerrainBackground) %>%
  addFullscreenControl() %>%
  addPolylines(lng = grl$shortest_path$lon, lat = grl$shortest_path$lat, opacity = 1, color = "#808080", weight = 3) %>%
  addCircles(lng = grl$shortest_path$lon, lat = grl$shortest_path$lat, opacity = 1, color = pal(factor(grl$shortest_path$sta_id, levels = pam$sta$sta_id)), weight = sta_duration^(0.3) * 10)

for (i in seq_len(nrow(path_sim$lon))) {
  m <- m %>%
    addPolylines(lng = path_sim$lon[i, ], lat = path_sim$lat[i, ], opacity = 0.5, weight = 1, color = "#808080") %>%
    addCircles(lng = path_sim$lon[i, ], lat = path_sim$lat[i, ], opacity = .7, weight = 1, color = pal(factor(grl$shortest_path$sta_id, levels = pam$sta$sta_id)))
}
m

Marginal probability map

li_s <- list()
l <- leaflet(width = "100%") %>%
  addProviderTiles(providers$Stamen.TerrainBackground) %>%
  addFullscreenControl()
for (i_r in seq_len(length(static_prob_marginal))) {
  i_s <- metadata(static_prob_marginal[[i_r]])$sta_id
  info <- metadata(static_prob_marginal[[i_r]])$temporal_extent
  info_str <- paste0(i_s, " | ", info[1], "->", info[2])
  li_s <- append(li_s, info_str)
  l <- l %>%
    addRasterImage(static_prob_marginal[[i_r]], colors = "OrRd", opacity = 0.8, group = info_str) %>%
    addCircles(lng = grl$shortest_path$lon[i_s], lat = grl$shortest_path$lat[i_s], opacity = 1, color = "#000", weight = 10, group = info_str)
}
l %>%
  addLayersControl(
    overlayGroups = li_s,
    options = layersControlOptions(collapsed = FALSE)
  ) %>%
  hideGroup(tail(li_s, length(li_s) - 1))

Appendix

Stationay period information

pam$sta
##                  start                 end sta_id
## 1  2017-06-20 00:00:00 2017-08-04 19:50:00      1
## 2  2017-08-04 23:15:00 2017-08-05 19:30:00      2
## 3  2017-08-06 02:50:00 2017-08-06 19:15:00      3
## 4  2017-08-07 03:10:00 2017-08-07 19:15:00      4
## 5  2017-08-08 00:10:00 2017-08-29 18:40:00      5
## 6  2017-08-30 04:30:00 2017-08-30 18:45:00      6
## 7  2017-08-31 04:10:00 2017-08-31 18:35:00      7
## 8  2017-09-01 09:00:00 2017-09-01 19:00:00      8
## 9  2017-09-02 09:00:00 2017-09-04 20:05:00      9
## 10 2017-09-05 04:35:00 2017-09-06 19:40:00     10
## 11 2017-09-07 04:35:00 2017-09-09 20:00:00     11
## 12 2017-09-10 01:15:00 2017-09-10 19:35:00     12
## 13 2017-09-11 02:45:00 2017-09-11 23:30:00     13
## 14 2017-09-12 00:20:00 2017-09-15 20:55:00     14
## 15 2017-09-16 04:30:00 2017-09-16 20:50:00     15
## 16 2017-09-17 01:55:00 2017-09-18 19:55:00     16
## 17 2017-09-18 23:40:00 2017-09-19 23:35:00     17
## 18 2017-09-20 01:05:00 2017-12-05 18:55:00     18
## 19 2017-12-06 05:35:00 2017-12-06 19:15:00     19
## 20 2017-12-07 00:10:00 2018-04-10 19:45:00     20
## 21 2018-04-11 00:00:00 2018-04-11 19:10:00     21
## 22 2018-04-12 05:50:00 2018-04-12 19:10:00     22
## 23 2018-04-13 05:40:00 2018-04-13 19:15:00     23
## 24 2018-04-14 05:30:00 2018-04-14 18:40:00     24
## 25 2018-04-15 15:00:00 2018-04-15 18:50:00     25
## 26 2018-04-15 22:00:00 2018-04-25 18:45:00     26
## 27 2018-04-26 02:40:00 2018-04-29 21:20:00     27
## 28 2018-04-30 03:05:00 2018-04-30 18:40:00     28
## 29 2018-05-01 01:10:00 2018-05-01 23:30:00     29

Parameter used for the simulation

set
## # A tibble: 1 × 29
##   gdl_id crop_start          crop_end            thr_dur extent_N extent_W
##   <chr>  <dttm>              <dttm>                <dbl>    <dbl>    <dbl>
## 1 18LX   2017-06-20 00:00:00 2018-05-02 00:00:00      12       50      -16
## # … with 23 more variables: extent_S <dbl>, extent_E <dbl>, map_scale <dbl>,
## #   map_max_sample <dbl>, map_margin <dbl>, prob_map_s <dbl>,
## #   prob_map_thr <dbl>, shift_k <dbl>, calib_lon <dbl>, calib_lat <dbl>,
## #   calib_1_start <dttm>, calib_1_end <dttm>, calib_2_start <lgl>,
## #   calib_2_end <lgl>, calib_2_lon <lgl>, calib_2_lat <lgl>,
## #   prob_light_w <dbl>, RingNo <lgl>, scientific_name <lgl>, common_name <chr>,
## #   mass <lgl>, wing_span <lgl>, Color <lgl>